home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue36 / system / RFMain.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-06-29  |  5.5 KB  |  166 lines

  1. unit RFMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, Registry, ComCtrls;
  8.  
  9. type
  10.     TForm1 = class(TForm)
  11.         ListBox1: TListBox;
  12.         FileTypesLabel: TLabel;
  13.         HeaderControl1: THeaderControl;
  14.         procedure FormCreate(Sender: TObject);
  15.         procedure FormDestroy(Sender: TObject);
  16.         procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  17.         procedure HeaderControl1SectionTrack(HeaderControl: THeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
  18.         procedure ListBox1DblClick(Sender: TObject);
  19.         procedure HeaderControl1SectionClick(HeaderControl: THeaderControl; Section: THeaderSection);
  20.         procedure ListBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  21.     private
  22.         { Private declarations }
  23.         SysReg: TRegIniFile;             { For accessing system registry }
  24.         ShowDesc: Boolean;               { True for descriptions, False for associations }
  25.         HeaderZeroSize: Integer;         { A little hackette for on-the-fly header resizing }
  26.         function GetStr (S: String; Idx: Integer): String;
  27.         procedure DeleteItem (const ItemString: String);
  28.     public
  29.         { Public declarations }
  30.     end;
  31.  
  32. var
  33.   Form1: TForm1;
  34.  
  35. implementation
  36.  
  37. {$R *.DFM}
  38.  
  39. function TForm1.GetStr (S: String; Idx: Integer): String;
  40. var
  41.     IdxPos: Integer;
  42. begin
  43.     while Idx <> 0 do begin
  44.         IdxPos := Pos (Chr (9), S);
  45.         S := Copy (S, IdxPos + 1, MaxInt);
  46.         Dec (Idx);
  47.     end;
  48.  
  49.     IdxPos := Pos (Chr (9), S);
  50.     if IdxPos = 0 then IdxPos := MaxInt;
  51.     Result := Copy (S, 1, IdxPos - 1);
  52. end;
  53.  
  54. procedure TForm1.FormCreate(Sender: TObject);
  55. var
  56.     Idx: Integer;
  57.     Desc, Str, CurSubKeyName: String;
  58.     SubKeys, FileExts: TStringList;
  59. begin
  60.     { Open the registry and access the hKey_Classes_Root hive }
  61.     SysReg := TRegIniFile.Create ('');
  62.     SysReg.RootKey := hKey_Classes_Root;
  63.     SysReg.OpenKey ('', False);
  64.  
  65.     { Create a temporary stringlist for holding raw subkey names }
  66.     SubKeys := TStringList.Create;
  67.  
  68.     { And another for holding tab-delimited file extensions }
  69.     FileExts := TStringList.Create;
  70.     try
  71.         SysReg.ReadSections (SubKeys);
  72.         for Idx := SubKeys.Count - 1 downto 0 do begin
  73.             CurSubKeyName := SubKeys [Idx];
  74.             if CurSubKeyName [1] = '.' then begin
  75.                 Str := SysReg.ReadString (CurSubKeyName, '', '');
  76.                 if Str <> '' then begin
  77.                     Desc := SysReg.ReadString (Str, '', '');
  78.                     if Desc <> '' then begin
  79.                         Str := SysReg.ReadString (Str + '\shell\open\command', '', '');
  80.                         if Str <> '' then FileExts.Add (CurSubKeyName + Chr(9) + Desc + Chr(9) + Str);
  81.                     end;
  82.                 end;
  83.             end;
  84.         end;
  85.  
  86.         ListBox1.Items.Assign (FileExts);
  87.         ListBox1.ItemIndex := 0;
  88.         FileTypesLabel.Caption := Format ('Registered File &Count = %d', [ListBox1.Items.Count]);
  89.     finally
  90.         SubKeys.Free;
  91.         FileExts.Free;
  92.     end;
  93.  
  94.     ShowDesc := True;
  95.     HeaderZeroSize := HeaderControl1.Sections [0].Width;
  96. end;
  97.  
  98. procedure TForm1.FormDestroy(Sender: TObject);
  99. begin
  100.     SysReg.Destroy;
  101. end;
  102.  
  103. procedure TForm1.ListBox1DrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  104. var
  105.     Idx: Integer;
  106.     ItemString: String;
  107. begin
  108.     with ListBox1.Canvas do begin
  109.         FillRect (Rect);
  110.         if odSelected in State then Font.Style := Font.Style + [fsBold];
  111.  
  112.         ItemString := ListBox1.Items [Index];
  113.         TextOut (Rect.Left + 5, Rect.Top, GetStr (ItemString, 0));
  114.         if ShowDesc then Idx := 1 else Idx := 2;
  115.         TextOut (HeaderZeroSize, Rect.Top, GetStr (ItemString, Idx));
  116.     end;
  117. end;
  118.  
  119. procedure TForm1.HeaderControl1SectionTrack(HeaderControl: THeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
  120. begin
  121.     if State = tsTrackMove then begin
  122.         HeaderZeroSize := Width;
  123.         ListBox1.Invalidate;
  124.     end;
  125. end;
  126.  
  127. procedure TForm1.HeaderControl1SectionClick (HeaderControl: THeaderControl; Section: THeaderSection);
  128. begin
  129.     if Section = HeaderControl1.Sections [1] then begin
  130.         ShowDesc := not ShowDesc;
  131.         if ShowDesc then Section.Text := 'File Description' else Section.Text := 'File Association';
  132.         ListBox1.Invalidate;
  133.     end;
  134. end;
  135.  
  136. procedure TForm1.DeleteItem (const ItemString: String);
  137. begin
  138.     with ListBox1 do begin
  139.         Items.Delete (ItemIndex);
  140.         ItemIndex := 0;
  141.         FileTypesLabel.Caption := Format ('Registered File &Count = %d', [ListBox1.Items.Count]);
  142.         { Now delete the registry stuff too }
  143.         SysReg.EraseSection (SysReg.ReadString (GetStr (ItemString, 0), '', ''));
  144.         SysReg.EraseSection (GetStr (ItemString, 0));
  145.     end;
  146. end;
  147.  
  148. procedure TForm1.ListBox1KeyDown (Sender: TObject; var Key: Word; Shift: TShiftState);
  149. var
  150.     ItemString: String;
  151. begin
  152.     if Key = vk_Delete then with ListBox1 do begin
  153.         ItemString := Items [ItemIndex];
  154.         if MessageDlg (Format ('Remove all registry entries for ''%s''?',
  155.                        [GetStr (ItemString, 0)]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  156.                        DeleteItem (ItemString);
  157.     end;
  158. end;
  159.  
  160. procedure TForm1.ListBox1DblClick(Sender: TObject);
  161. begin
  162.     ShowMessage ('Hi!');
  163. end;
  164.  
  165. end.
  166.